home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
United Public Domain Gold 2
/
United Public Domain Gold 2.iso
/
utilities
/
pu281.dms
/
pu281.adf
/
EATIT.MOD
< prev
next >
Wrap
Text File
|
1991-12-17
|
3KB
|
77 lines
(***************************************************************************
* Programme : EatIt.mod *
* Usage : EatIT *
* Version : V1.05 *
* Date : 16.-17.12.1989 *
* Author : Jörg Sixt *
* Purpose : Another boring "damage-the-screen-hack" *
* Language : Modula-2,AMSoft PD-Version from Fish 113 *
* Bugs : it works *
***************************************************************************)
MODULE EatIT ;
FROM SYSTEM IMPORT ADR ;
FROM Graphics IMPORT RastPortPtr,SetAPen,ReadPixel,WritePixel ;
FROM Intuition IMPORT ScreenPtr,IntuitionBase,OpenIntuition,CurrentTime ;
FROM Dos IMPORT Delay ;
CONST MAX = 20 ;
VAR ok : BOOLEAN ;
i,j,width,height : INTEGER ;
IBase : POINTER TO IntuitionBase ;
Scr : ScreenPtr ;
RP : RastPortPtr ;
dummy : LONGINT ;
xm,ym : ARRAY [1..MAX] OF INTEGER ;
xp,yp : ARRAY [1..8] OF INTEGER ;
PROCEDURE RND(limit : INTEGER) : INTEGER ;
VAR mic,sec : ARRAY [1..2] OF INTEGER ;
long : LONGINT ;
BEGIN
CurrentTime(ADR(sec),ADR(mic)) ;
long := (LONGINT(limit-1)*LONGINT(mic[2])) DIV 32770 ;
RETURN(INTEGER(ABS(long))+1) ;
END RND ;
BEGIN (* MAIN PROGRAMME *)
xp[1] := -1 ; yp[1] := -1 ; xp[2] := 0 ; yp[2] := -1 ;
xp[3] := 1 ; yp[3] := -1 ; xp[4] := 1 ; yp[4] := 0 ;
xp[5] := 1 ; yp[5] := 1 ; xp[6] := 0 ; yp[6] := 1 ;
xp[7] := -1 ; yp[7] := 1 ; xp[8] := -1 ; yp[8] := 0 ;
IBase := OpenIntuition() ;
Scr := IBase^.activeScreen ;
RP := ADR(Scr^.rastPort) ;
width := Scr^.width-1 ;
height:= Scr^.height-1 ;
FOR i := 1 TO MAX DO
xm[i] := RND(width) ; ym[i] := RND(height) ;
Delay(2) ;
END ;
LOOP
FOR i := 1 TO MAX DO
ok := TRUE ;
SetAPen(RP,0) ; dummy := WritePixel(RP,xm[i],ym[i]) ;
FOR j := 1 TO 8 DO
IF ((ReadPixel(RP,xm[i]+xp[j],ym[i]+yp[j])>0) AND ok) THEN
ok := FALSE ; INC(xm[i],xp[j]) ; INC(ym[i],yp[j]) ;
END ;
END ;
IF ok THEN
INC(xm[i],xp[RND(8)]) ; INC(ym[i],yp[RND(8)]) ;
IF (xm[i]<0) THEN xm[i] := width ; END ;
IF (ym[i]<0) THEN ym[i] := height ; END ;
IF (xm[i]>width) THEN xm[i] := 0 ; END ;
IF (ym[i]>height) THEN ym[i] := 0 ; END ;
END ;
SetAPen(RP,2) ; dummy := WritePixel(RP,xm[i],ym[i]) ;
Delay(1) ;
END ;
END ;
END EatIT.